home *** CD-ROM | disk | FTP | other *** search
/ HPAVC / HPAVC CD-ROM.iso / pc / ML_BME1.ZIP / RIPPLES / RIPPLES.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1996-12-21  |  3.1 KB  |  157 lines
  1. {
  2.  Ripples generator, by Maple Leaf, Nov 1996
  3.  ---------------------------------------------------------------------------
  4.  This could be used as an anti-publicity program for TP's floating point
  5.  emulation...  What would I do if I hadn't the assembler to program with ?
  6.  Oh, shit...
  7.  ----------------------------------------------------------------------------
  8.  Do whatever you want with this crappy code, but if you use parts of it in
  9.  your production(s), please send some greets to Maple Leaf (Gruian Radu).
  10.  Thanx.
  11. }
  12.  
  13. uses alloc, files, bitmap;
  14.  
  15. var vScr, sqrTab : word;
  16.     Img : pointer;
  17.     Pal : array[byte] of record r,g,b:byte end;
  18.  
  19.     Wave : array [0..199] of word;  { 200 words are quite enough ... }
  20.  
  21. procedure InitVideo;near;assembler;
  22. asm
  23.   mov ax,13h
  24.   int 10h  { init video mode }
  25.   mov dx,3c8h
  26.   mov al,0
  27.   out dx,al
  28.   inc dx
  29.   mov cx,768
  30.   mov si,offset pal
  31.   rep outsb { set palette }
  32. end;
  33.  
  34. procedure vWait;near;assembler;
  35. asm
  36.     mov dx,3DAh
  37. @1: in al,dx
  38.     test al,8
  39.     jne @1
  40. @2: in al,dx
  41.     test al,8
  42.     je @2
  43. end;
  44.  
  45. procedure ShowVScreen;near;assembler;
  46. asm
  47.   push ds
  48.   push es
  49.   mov cx,16000
  50.   mov ax,0A000h
  51.   mov es,ax
  52.   mov di,0
  53.   mov si,di
  54.   mov ds,VScr
  55.   cld
  56.   db 66h; rep movsw
  57.   pop es
  58.   pop ds
  59. end;
  60.  
  61. procedure freeAll;
  62. begin
  63.   free(img);
  64.   hfree(vScr);
  65.   hfree(sqrTab);
  66. end;
  67.  
  68. procedure InitData;
  69. begin
  70.   vScr:=halloc(64000);
  71.   sqrTab:=halloc(161*101*2);  { [0..160,0..100] of word }
  72.   Img:=LoadPCX(paramstr(1),@pal);
  73.   if (Img=nil) or (vScr=0) or (sqrTab=0) then begin
  74.     freeAll;
  75.     asm mov ax,3; int 10h end;
  76.     writeln('Not enough memory');
  77.     halt
  78.   end;
  79. end;
  80.  
  81. procedure PreCalc;  { this shit will take some time... }
  82. var x,y,k:word;
  83. begin
  84.   for x:=0 to 160 do
  85.     for y:=0 to 100 do begin
  86.       k:=trunc( sqrt( sqr(x) + sqr(y) ) );
  87.       memw[sqrTab:(y*161+x)*2]:=k;
  88.     end;
  89. end;
  90.  
  91. var ang:word;
  92.  
  93. procedure UpdateWave;
  94. const Amplitude  : word = 10;
  95.       Frequency  : word = 15; { ripples/(160 pixels) }
  96. var   k:word;
  97. begin
  98.   inc(ang,1);
  99.   for k:=0 to 199 do
  100.     Wave[k]:=trunc(Amplitude*sin(Frequency*(k-ang)*pi/180));
  101. end;
  102.  
  103. procedure DrawRipples;
  104. var x,y,offs,offs2,dist:integer;
  105.     byt:byte;
  106.     xx,yy,alt:integer;
  107. procedure stosb;
  108. begin
  109.   mem[vScr:offs]:=byt;
  110.   inc(offs);
  111. end;
  112. begin
  113.   offs:=0;
  114.   for y:=0 {!!!} to 199 do begin    { fuck ! }
  115.     for x:=0 {!!!} to 319 do begin
  116.  
  117.       xx:=abs(x-160);
  118.       yy:=abs(y-100);
  119.  
  120.       dist:=memw[sqrTab:2*(yy*161+xx)];  { compute distance to origin (160,100) }
  121.       alt:=Wave[dist];                   { altitude of this dot }
  122.  
  123.       xx:=x;
  124.       yy:=y+alt;
  125.       if yy>199 then yy:=yy-200;
  126.       if yy<0 then yy:=yy+200;
  127.       offs2:=yy*320+xx;
  128.  
  129.       byt:=mem[seg(img^):word(offs2)];
  130.       stosb;
  131.     end;
  132.   end;
  133. end;
  134.  
  135. procedure DoIt;
  136. begin
  137.   Precalc;
  138.   repeat
  139.     UpdateWave;
  140.     DrawRipples;
  141.     vWait;
  142.     ShowVScreen;{}
  143.   until port[$60]=1;
  144. end;
  145.  
  146. begin
  147.   if paramcount=0 then begin
  148.     writeln('RIPPLES FileName.PCX');
  149.     halt
  150.   end;
  151.   InitData;
  152.   InitVideo;
  153.   DoIt;
  154.   asm mov ax,3; int 10h end;
  155.   freeAll;
  156. end.
  157.